##
## 1 2 3 4 5 6
## 6830 963 1945 5589 1604 15310
group_by(A0, grp) %>% summarise(
recent=mean(r),
freq=mean(f),
money=mean(m),
mcqty = mean(cqty),
mraw = mean(raw),
mccost = mean(ccost),
size=n() ) %>%
mutate( revenue = size*money/1000, avgp = size*money/mcqty, gross = mraw*size/1000, avgc = size*mccost/1000) %>%
filter(size > 1) %>%
ggplot(aes(x=freq, y=money)) +
geom_point(aes(size=gross, col=recent),alpha=0.5) +
scale_size(range=c(4,30)) +
scale_color_gradient(low="green",high="red") +
scale_x_log10() + scale_y_log10(limits=c(300,3000)) +
geom_text(aes(label = size ),size=3) +
theme_bw() + guides(size=F) +
labs(title="Customer Segements",
subtitle="(bubble_size:Revenue_contribution; text:group_size)",
color="Recency") +
xlab("Frequency (log)") + ylab("Average Transaction Amount (log)")## Warning: Removed 1 rows containing missing values (geom_point).
## Warning: Removed 1 rows containing missing values (geom_text).
## Joining, by = "cust"
B = B %>% filter(grp != 2) # 排除分群2
B$grp[which(B$grp==6)] <- 2 # 將分群6置換至2
table(B$grp, useNA = "ifany")##
## 1 2 3 4 5
## 4192 15310 986 5589 1604
B %>%
group_by(grp) %>%
summarise(
size = n(),
AvgBuy = mean(Buy),
AvgRev = mean(Rev),
TotalRev = sum(Rev),
)## # A tibble: 5 x 5
## grp size AvgBuy AvgRev TotalRev
## <dbl> <int> <dbl> <dbl> <dbl>
## 1 1 4192 0.283 619. 2596658.
## 2 2 15310 0.501 711. 10889303.
## 3 3 986 0.259 1398. 1378565.
## 4 4 5589 0.419 1367. 7638205.
## 5 5 1604 0.945 1861. 2985452.
DP = function(x,m0,b0,a0) {m0*plogis((10/a0)*(x-b0))}
par(mar=c(4,4,2,1),mfrow=c(1,2),cex=0.7)
# 用curve指令函數設定m, b, a
curve(DP(x,m=0.25,b=19,a=10), 0, 30, lwd=2, ylim=c(0, 0.25),
main="F( x | m=0.25, b=19, a=10 )", ylab="delta P")
abline(h=seq(0,0.2,0.05),v=seq(0,30,5),col='lightgrey',lty=2)
m=0.1; b=150; a=200; x=200;gm=0.15*3
dp = DP(x,m,b,a)
#dp = ifelse(B$Buy+dp>1, 1-B$Buy, dp)
eR = gm*dp*B$Buy*B$Rev - x
hist(eR)\[\Delta P = f(x|m,b,a) = m \cdot Logis(\frac{10(x - b)}{a})\]
\[\hat{R}(x) = \left\{\begin{matrix} \Delta P \cdot M - x & , & P + \Delta P \leq 1\\ (1-P) \cdot M - x & , & else \end{matrix}\right.\]
行銷工具1
manipulate({##############################
# 用curve指令函數設定m, b, a
curve(DP(x,m=0.20,b=15,a=20), 0, 30, lwd=2, ylim=c(0, 0.25),
main="F( x | m=0.2, b=15, a=20 )", ylab="delta P")
abline(h=seq(0,0.2,0.05),v=seq(0,30,5),col='lightgrey',lty=2)
},########################################
m = slider(0.05, 0.35, 0.20, step=0.01),
a = slider( 10, 40, 25, step=1),
b = slider( 4, 40, 20, step=1)
)gm = 0.15 * 3
m=0.05; b=50; a=100; X = seq(10,120,1)
sapply(X, function(x) {
dp = DP(x,m,b,a)
#dp = ifelse(B$Buy+dp>1, 1-B$Buy, dp)
eR = gm*dp*B$Buy*B$Rev - x # 改成回購的機率
c(x=x, eReturn=sum(eR), N=sum(eR > 0), eReturn2=sum(eR[eR > 0]))
}) %>% t %>% data.frame %>%
gather('key','value',-x) %>%
ggplot(aes(x=x, y=value, col=key)) +
geom_hline(yintercept=0,linetype='dashed') +
geom_line(size=1.5,alpha=0.5) +
facet_wrap(~key,ncol=1,scales='free_y') + theme_bw()manipulate({####################################
do.call(rbind, lapply(seq(5,50,0.5), function(x){
dp = DP(x,m,b,a)
B %>% mutate(
#dp = ifelse(Buy+dp>1, 1-Buy, dp),
eR = gm*dp*B$Buy*B$Rev - x # 行銷工具
) %>%
group_by(grp) %>% summarise(
Cost = x,
Group.Sz = n(),
eR.ALL = sum(eR>0),
eR.SEL = sum(eR[eR>0]),
) } ) ) %>%
ggplot(aes(x=Cost, y=eR.SEL, col=factor(grp))) +
geom_line(size=1.2) +
ggtitle("Cost Effeciency")
},######################################
m = slider(0.05, 0.25, 0.20, step=0.01),
a = slider( 10, 30, 25, step=1),
b = slider( 10, 50, 20, step=5)
) X = seq(10, 250, 1) ;mm=0.25 ;bb=19;aa= 10
df = do.call(rbind, lapply(1:5, function(i) {
sapply(X, function(x) {
dp = DP(x,mm,bb,aa)
#dp = ifelse(B$Buy[B$grp==i]+dp>1, 1-B$Buy[B$grp==i], dp)
eR = gm*dp*B$Buy[B$grp==i]*B$Rev[B$grp==i] - x
c(i=i, x=x, eR.ALL=sum(eR), N=sum(eR>0), eR.SEL=sum(eR[eR > 0]) )
}) %>% t %>% data.frame
}))
df %>% gather('key','value',-i,-x) %>%
mutate(Group = paste0('Grp',i)) %>%
ggplot(aes(x=x, y=value, col=Group)) +
geom_hline(yintercept=0, linetype='dashed', col='blue') +
geom_line(size=1.5,alpha=0.5) +
xlab('工具選項(成本)') + ylab('預期報償') +
ggtitle('行銷工具優化','假設行銷工具的效果是其成本的函數') +
facet_wrap(~key,ncol=1,scales='free_y') + theme_bw()profitRate=gm; Bu=G2$Buy;Re=G2$Rev
m=0.25; a=10; b=19; x = 15
increasingRate = DP(x,m,a,b)
returnTotal = sum(Bu*Re*increasingRate*profitRate-x)
costTotal = length(Bu)*x
data.frame(x=x, increasingRate=increasingRate, returnTotal=returnTotal, costTotal=costTotal, ROI=returnTotal/costTotal)## x increasingRate returnTotal costTotal ROI
## 1 15 0.2332166 382408.7 229650 1.665181
最佳策略(不能選擇行銷對象)
## # A tibble: 5 x 5
## # Groups: i [5]
## i x eR.ALL N eR.SEL
## <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 1 22 -13285. 1361 10982.
## 2 2 23 292175. 10566 330632.
## 3 3 23 16784. 962 16946.
## 4 4 23 239302. 5473 239898.
## 5 5 24 283751. 1602 283769.
最佳策略(可以選擇行銷對象)
## # A tibble: 5 x 5
## # Groups: i [5]
## i x eR.ALL N eR.SEL
## <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 1 22 -13285. 1361 10982.
## 2 2 23 292175. 10566 330632.
## 3 3 23 16784. 962 16946.
## 4 4 23 239302. 5473 239898.
## 5 5 24 283751. 1602 283769.
\[ E(\pi) = g * p * m \\ E(\hat{\pi}) = g * (p+\Delta p) * m(1+\Delta m) \\ E(r) = E(\hat{\pi}) - E(\pi) - x \\ \Delta p(x|m_1,b_1,a_1) \; ;\; \Delta m(x|m_2,b_2,a_2) \]
DP = function(x,m0,b0,a0) {m0*plogis((10/a0)*(x-b0))}
par(mar=c(4,4,2,1),mfrow=c(1,2),cex=0.7)
# 用curve指令函數設定m, b, a
curve(DP(x,m=0.1,b=90,a=100), 50, 200, lwd=2, ylim=c(0, 0.1),
main="F( x | m=0.25, b=19, a=10 )", ylab="delta P")
abline(h=seq(0,0.2,0.05),v=seq(0,30,5),col='lightgrey',lty=2)
curve(DP(x,m=0.3,b=90,a=100), 50, 200, lwd=2, ylim=c(0, 0.3),
main="F( x | m=0.25, b=19, a=10 )", ylab="delta m")
abline(h=seq(0,0.2,0.05),v=seq(0,30,5),col='lightgrey',lty=2)行銷工具2
mm=0.1; bb=90; aa=100
mm2=0.3 ;bb2=90; aa2=100
X = seq(10, 250, 5)
df = do.call(rbind, lapply(1:5, function(i) {
sapply(X, function(x) {
dp = DP(x,mm,bb,aa)
dp = ifelse(B$Buy[B$grp==i]+dp>1, 1-B$Buy[B$grp==i], dp)
dm = DP(x,mm2,bb2,aa2)
eR = ((B$Buy[B$grp==i]+dp) * B$Rev[B$grp==i]*(1+dm) - B$Rev[B$grp==i]*B$Buy[B$grp==i]) * gm - x
c(i=i, x=x, eR.ALL=sum(eR), N=sum(eR>0), eR.SEL=sum(eR[eR > 0]) )
}) %>% t %>% data.frame
}))
df %>% gather('key','value',-i,-x) %>%
mutate(Group = paste0('Grp',i)) %>%
ggplot(aes(x=x, y=value, col=Group)) +
geom_hline(yintercept=0, linetype='dashed', col='blue') +
geom_line(size=1.5,alpha=0.5) +
xlab('工具選項(成本)') + ylab('預期報償') +
ggtitle('行銷工具優化','假設行銷工具的效果是其成本的函數') +
facet_wrap(~key,ncol=1,scales='free_y') + theme_bw()最佳策略(不能選擇行銷對象)
## # A tibble: 5 x 5
## # Groups: i [5]
## i x eR.ALL N eR.SEL
## <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 1 10 -41847. 0 0
## 2 2 10 -152672. 0 0
## 3 3 115 4398. 524 12675.
## 4 4 120 178068. 3679 220472.
## 5 5 120 227592. 1416 231853.
最佳策略(可以選擇行銷對象)
## # A tibble: 5 x 5
## # Groups: i [5]
## i x eR.ALL N eR.SEL
## <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 1 115 -252257. 63 874.
## 2 2 120 -488949. 3379 142028.
## 3 3 115 4398. 524 12675.
## 4 4 120 178068. 3679 220472.
## 5 5 125 227109. 1400 232012.
🗿 比較:
營收的部分,是主力顧客成長較多,但是報酬率是勤儉一族表現較好
而獲利增長則是主力顧客較多,兩個方案都各自有比較好的地方